home
***
CD-ROM
|
disk
|
FTP
|
other
***
search
/
BMUG Revelations
/
BMUG Revelations.toast
/
Programming
/
Programming Languages
/
Yerk 3.64
/
tool+
/
textEdit
< prev
next >
Wrap
Text File
|
1993-05-31
|
3KB
|
99 lines
\ textEdit class based on bjr 1987
\ 12.11.89 rfl now subclass of handle
\ A lot of these methods leave the current font of the window changed.
\ 4.17.91 rfl fixed rect1...actually should move into rect
\ 4.23.91 rfl added addText:
\ 10.18.91 rfl protect for 32k limit
$ 7fff value teLimit
:CLASS TextEdit <Super handle
Rect ViewRect \ as in IM V1
Rect DestRect \ ditto
:M PtIn: ( -- b) where: theMouse pack ptIn: viewrect ;M
:M TEString: ( addr len -- AbsAddr Length) swap +Base swap ;M
\ first set up rects
:M New: { myWind -- }
alive: myWind not classerr" 133
PushPort set: myWind
0 Abs: DestRect Abs: ViewRect Call TENew m!
PopPort ;M
:M alive: ( -- b) m@ 0 <> ;M
:M close: m@ -dup IF Call TEDispose 0 m! THEN ;M
:M justify: ( Just --) MakeInt m@ Call TESetJust ;M
:M SetSelect: ( Start End --) m@ Call TESetSelect ;M
:M HighLight: 0 1000 setSelect: self ;M
:M moveTo: ( Position --) Dup SetSelect: Self ;M
:M Activate: m@ Call TEActivate ;M
:M Deactivate: m@ Call TEDeactivate ;M
:M teCut: m@ Call TECut ;M
:M teCopy: m@ Call TECopy ;M
:M tePaste: m@ Call TEPaste ;M
:M teDelete: m@ Call TEDelete ;M
:M GetScrap: ( -- addr len) global TEScrpHandle @ >ptr global TEScrpLength w@ ;M
:M PutText: ( addr len --) TEString: Self m@ Call TESetText ;M
:M GetText: ( -- addr len)
0 m@ Call TEGetText >ptr ptr: self 60 + w@ ;M
:M ReCal: m@ call TECalText ;M
:M textSize: ( -- len) getText: self swap drop ;M
:M overLimit?: ( len -- len b) dup textSize: self + teLimit > ;M
:M clear: 0 textSize: self setSelect: self TEDelete: self ;M
:M Insert: ( addr len --) TEString: Self m@ Call TEInsert ;M
:M Key: ( char --) MakeInt m@ Call TEKey ;M
\ could change teDelete to TeCut to do something with top of text
\ for right now, delete twice the new addition and creep up to top again
:M AddText: ( addr len --) overLimit?: self
IF 0 over 2* setSelect: self teDelete: self
THEN
textSize: self 1+ moveto: self insert: self ;M
:M Draw: clear: destRect
Abs: destRect m@ Call TEUpdate ;M
:M print: abs: destRect m@ call TEUpdate ;M
:M Scroll: ( dh dv--) pack m@ Call TEScroll ;M
:M Click: where: themouse pack false Bool m@ Call TEClick ;M
:M Idle: m@ Call TEIdle ;M
:M PutRect: ( l t r b --) put: viewRect get: viewRect put: destRect
m@ IF get: destRect ptr: self put: rect
get: viewRect ptr: self 8+ put: rect
THEN ;M
:M ChangeRect: get: destRect ptr: self put: rect get: viewRect ptr: self 8+ put: rect ;M
:M OffSet: { dx dy -- }
dx dy OffSet: viewRect get: viewRect put: destRect ;M
:M InsetDest: ( dx dy --) Inset: DestRect ;M
;CLASS